home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / gls / libguile.scm < prev    next >
Encoding:
Text File  |  1995-01-07  |  6.2 KB  |  182 lines

  1. ;;; $Id: libguile.scm,v 1.3 1995/01/07 21:44:14 miles Exp $
  2. ;;; ----------------------------------------------------------------
  3. ;;; libguile.scm -- Basic guile interfaces
  4. ;;; 21 Dec 1994, Miles Bader <miles@eskimo.com>
  5. ;;; ----------------------------------------------------------------
  6. ;;;
  7.  
  8. (in-package GUILE)
  9.  
  10. (export-library GUILE
  11.  (GUILE SCHEME R4RS MODULE VARIABLE GUILE-INTERNALS SLIB-HOOKS
  12.   VICINITY RECORD TIME DEFMACRO SCM-ERRORS SCM-TIMERERS SCM))
  13. (export-library SCHEME
  14.  (SCHEME SCM R4RS GUILE))
  15.  
  16. ;; ----------------------------------------------------------------
  17. (in-module GUILE)
  18.  
  19. ;; The standard guile definitions
  20. ;;
  21. (export-interface SCHEME
  22.  (;; syntax
  23.   quote quasiquote unquote unquote-splicing
  24.   lambda and or if cond case define set! let let* letrec begin do 
  25.   ;; test
  26.   not boolean? eq? eqv? equal?
  27.   ;; lists
  28.   pair? cons car cdr set-car! set-cdr!
  29.   caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar
  30.   caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar
  31.   cdaddr cddaar cddadr cdddar cddddr
  32.   null? list? list length append reverse list-ref memq memv member assq assv
  33.   assoc
  34.   ;; symbols
  35.   symbol? symbol->string string->symbol
  36.   ;; numbers
  37.   number? complex? real? rational? integer? exact? inexact? = < > <= >= zero?
  38.   positive? negative? odd? even? max min + * - / abs quotient remainder
  39.   modulo gcd lcm numerator denominator floor ceiling truncate round
  40.   rationalize exp log sin cos tan asin acos atan sqrt expt make-rectangular
  41.   make-polar real-part imag-part magnitude angle exact->inexact
  42.   inexact->exact number->string string->number
  43.   ;; characters
  44.   char? char=? char-ci=? char<? char-ci<? char>? char-ci>? char<=? char-ci<=?
  45.   char>=? char-ci>=? char-alphabetic? char-numeric? char-whitespace?
  46.   char-upper-case? char-lower-case? char->integer integer->char char-upcase
  47.   char-downcase
  48.   ;; strings
  49.   string? make-string string string-length string-ref string-set! string=?
  50.   string-ci=? string<? string-ci<? string>? string-ci>? string<=?
  51.   string-ci<=? string>=? string-ci>=? substring string-append
  52.   ;; vectors
  53.   vector? make-vector vector vector-length vector-ref vector-set!
  54.   ;; procs
  55.   procedure? apply map for-each call-with-current-continuation 
  56.   ;; files
  57.   call-with-input-file call-with-output-file input-port? output-port?
  58.   current-input-port current-output-port open-input-file open-output-file
  59.   close-input-port close-output-port eof-object? read read-char peek-char
  60.   write display newline write-char 
  61.   ))
  62.  
  63. (export-interface R4RS
  64.  (list-tail string->list list->string string-copy string-fill! vector->list
  65.   list->vector vector-fill! delay force with-input-from-file
  66.   with-output-to-file char-ready? load transcript-on transcript-off
  67.   define-syntax let-syntax letrec-syntax)
  68.  ;; + base scheme
  69.  SCHEME)
  70.  
  71. (export-interface EXTRAS
  72.  (output-port-width output-port-height current-error-port
  73.   file-exists? delete-file force-output char-code-limit most-positive-fixnum
  74.   identity gentemp 1+ -1+ 1-
  75.   call-with-input-string call-with-output-string
  76.   program-arguments getenv acons copy-tree
  77.   eval dynamic-wind try-load append!
  78.   software-type scheme-implementation-version scheme-implementation-type))
  79.  
  80. (export-interface GUILE
  81.  (define-macro delq!
  82.   quit restart abort verbose gc room terms
  83.   error system exec)
  84.  EXTRAS
  85.  R4RS)
  86.  
  87. ;; ----------------------------------------------------------------
  88.  
  89. ;; More tricky stuff...
  90. ;;
  91. (export-interface GUILE-INTERNALS
  92.  (*top-level-lookup-thunk*
  93.   *load-module* try-load-in-current-module))
  94.  
  95. (export-interface VARIABLE
  96.  (make-variable make-undefined-variable
  97.   variable-ref variable-set! variable-bound?))
  98.  
  99. ;; ----------------------------------------------------------------
  100.  
  101. (export-interface SLIB-HOOKS
  102.  (*features*
  103.   slib:load-source slib:load slib:eval-load
  104.   slib:exit slib:error slib:tab slib:form-feed slib:eval
  105.   defmacro:load defmacro:eval
  106.   tmpnam))
  107.  
  108. (export-interface TIME
  109.  (current-time difftime offset-time))
  110.  
  111. (export-interface VICINITY
  112.  (in-vicinity
  113.   implementation-vicinity library-vicinity program-vicinity))
  114.  
  115. (export-interface RECORD
  116.  (make-record-type record-constructor record-predicate record-accessor
  117.   record-modifier))
  118.  
  119. (export-interface DEFMACRO
  120.  (defmacro macroexpand macroexpand-1))
  121.  
  122. ;; ----------------------------------------------------------------
  123. ;; Somewhat icky scm interfaces some of these are user-defined things;
  124. ;; unfortunately, the module systems means that the system won't see these if
  125. ;; (define ...) is used, so we need some other interface for them.  there
  126. ;; needs to to be a real exception system anyway...
  127.  
  128. (export-interface SCM-TIMERS
  129.  (ticks alarm
  130.   ticks-interrupt user-interrupt alarm-interrupt))
  131.  
  132. (export-interface SCM-ERRORS
  133.  (errno perror
  134.   ;; The following are user-defined things; unfortunately, the module systems
  135.   ;; means that the system won't see these if (define ...) is used, so we
  136.   ;; need some other interface for them.  there needs to to be a real
  137.   ;; exception system anyway...
  138.   out-of-storage could-not-open end-of-program hang-up arithmetic-error))
  139.  
  140. (export-interface SCM
  141.  (quit restart error errobj abort
  142.   verbose gc room terms list-file system exec
  143.   tmpnam *scm-version*)
  144.  ;; + other stuff
  145.  DEFMACRO
  146.  VICINITY
  147.  TIME
  148.  RECORD
  149.  SLIB-HOOKS
  150.  SCM-ERRORS
  151.  SCM-TIMERS
  152.  EXTRAS
  153.  R4RS)
  154.  
  155. ;; ----------------------------------------------------------------
  156.  
  157. (use-interface module)            ; do more complex module operations
  158.  
  159. ;; ----------------------------------------------------------------
  160. ;; More guile module support stuff
  161.  
  162. ;; *LOAD-MODULE* -- exported
  163. ;;
  164. ;; This should be either a module, which will be current module when a file
  165. ;; is loaded, or a procedure which when called (with arguments ???) will
  166. ;; return a module to use.
  167. ;; 
  168. (define *load-module*
  169.   ;; start out with the `default/default' module.
  170.   (find-module 'default
  171.            (find-module 'default *root-package* make-package)
  172.            make-user-module))
  173.            
  174. (define try-load-in-current-module try-load)
  175. ;; Redefine try-load to bind the current module to *load-module* during loading
  176. ;; (try-load is called by load)
  177. (define (try-load file)
  178.   (let ((old-module (current-module)))
  179.     (dynamic-wind (lambda () (set-current-module *load-module*))
  180.           (lambda () (try-load-in-current-module file))
  181.           (lambda () (set-current-module old-module)))))
  182.